VERSION 5.00Begin VB.Form Form1 Caption = "楼梯断面图" ClientHeight = 3240 ClientLeft = 5685 ClientTop = 4185 ClientWidth = 3720 LinkTopic = "Form1" ScaleHeight = 3240 ScaleWidth = 3720 Begin VB.CommandButton cmdExit Caption = "退出(&X)" Height = 375 Left = 2400 TabIndex = 23 Top = 2760 Width = 1215 End Begin VB.CommandButton cmdDraw Caption = "绘图(&D)" Height = 375 Left = 2400 TabIndex = 22 Top = 2280 Width = 1215 End Begin VB.CommandButton cmdCal Caption = "计算(&C)" Height = 375 Left = 2400 TabIndex = 21 Top = 1800 Width = 1215 End Begin VB.Frame Frame3 Caption = "楼梯梁参数" Height = 1455 Left = 120 TabIndex = 14 Top = 1680 Width = 2055 Begin VB.TextBox txtGirderW Height = 285 Left = 1060 TabIndex = 17 Top = 330 Width = 855 End Begin VB.TextBox txtGirderH Height = 285 Left = 1060 TabIndex = 16 Top = 690 Width = 855 End Begin VB.TextBox txtBoardT Height = 285 Left = 1060 TabIndex = 15 Top = 1050 Width = 855 End Begin VB.Label Label9 Caption = "楼梯梁宽" Height = 255 Left = 240 TabIndex = 20 Top = 360 Width = 855 End Begin VB.Label Label8 Caption = "楼梯梁高" Height = 255 Left = 240 TabIndex = 19 Top = 720 Width = 855 End Begin VB.Label Label7 Caption = "楼板厚" Height = 255 Left = 240 TabIndex = 18 Top = 1080 Width = 855 End End Begin VB.Frame Frame2 Caption = "踏步参数" Height = 1455 Left = 1680 TabIndex = 7 Top = 120 Width = 1900 Begin VB.TextBox txtStepH Height = 285 Left = 900 TabIndex = 10 Top = 330 Width = 855 End Begin VB.TextBox txtStepW Height = 285 Left = 900 TabIndex = 9 Top = 690 Width = 855 End Begin VB.TextBox txtStepNum Height = 285 Left = 900 TabIndex = 8 Top = 1050 Width = 855 End Begin VB.Label Label6 Caption = "踏步高" Height = 255 Left = 240 TabIndex = 13 Top = 360 Width = 855 End Begin VB.Label Label5 Caption = "踏步宽" Height = 255 Left = 240 TabIndex = 12 Top = 720 Width = 855 End Begin VB.Label Label4 Caption = "级数" Height = 255 Left = 240 TabIndex = 11 Top = 1080 Width = 855 End End Begin VB.Frame Frame1 Caption = "基点" Height = 1455 Left = 120 TabIndex = 0 Top = 120 Width = 1455 Begin VB.TextBox txtPtZ Height = 285 Left = 480 TabIndex = 6 Top = 1050 Width = 855 End Begin VB.TextBox txtPtY Height = 285 Left = 480 TabIndex = 4 Top = 690 Width = 855 End Begin VB.TextBox txtPtX Height = 285 Left = 480 TabIndex = 2 Top = 330 Width = 855 End Begin VB.Label Label3 Caption = "Z:" Height = 255 Left = 240 TabIndex = 5 Top = 1080 Width = 255 End Begin VB.Label Label2 Caption = "Y:" Height = 255 Left = 240 TabIndex = 3 Top = 720 Width = 255 End Begin VB.Label Label1 Caption = "X:" Height = 255 Left = 240 TabIndex = 1 Top = 360 Width = 255 End EndEndAttribute VB_Name = "Form1"Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = FalseAttribute VB_PredeclaredId = TrueAttribute VB_Exposed = FalseOption ExplicitDim bCal As Boolean '是否已经进行计算'存储楼梯上层各点的坐标Dim ptArr1() As Double'楼梯下侧各点的坐标Dim ptArr2(19) As DoublePrivate Sub cmdCal_Click() '判断是否缺少参数 Dim objControl As Control For Each objControl In Form1.Controls If TypeOf objControl Is TextBox Then If objControl.Text = "" Then MsgBox "缺少参数，无法计算！", vbCritical Exit Sub End If End If Next '获得计算所需参数值 Dim x0 As Double, y0 As Double '定位基点 Dim s As Double, t As Double, n As Double '踏步的高、宽和级数 Dim b As Double, h As Double, h0 As Double '楼梯梁的宽、高和楼板厚 x0 = txtPtX.Text: y0 = txtPtY.Text s = txtStepH.Text: t = txtStepW.Text: n = txtStepNum.Text b = txtGirderW.Text: h = txtGirderH.Text: h0 = txtBoardT.Text '约束条件 If h0 >= h Or b > 80 Or s >= t Then MsgBox "输入条件不合要求，请检查参数的合理性！", vbCritical Exit Sub End If ReDim ptArr1(2 * (2 * n 2) - 1) '计算上半部各点的坐标 ptArr1(0) = x0 - 100: ptArr1(1) = y0 ptArr1(2) = x0: ptArr1(3) = y0 ptArr1(4) = x0: ptArr1(5) = y0 s Dim i As Integer For i = 6 To 2 * (2 * n 2) - 3 If i Mod 4 = 2 Then ptArr1(i) = ptArr1(i - 4) t ElseIf i Mod 4 = 3 Then ptArr1(i) = ptArr1(i - 4) s ElseIf i Mod 4 = 0 Then ptArr1(i) = ptArr1(i - 2) ElseIf i Mod 4 = 1 Then ptArr1(i) = ptArr1(i - 2) s End If Next i ptArr1(2 * (2 * n 2) - 2) = ptArr1(2 * (2 * n 2) - 4) 100 ptArr1(2 * (2 * n 2) - 1) = ptArr1(2 * (2 * n 2) - 3) '计算下半部各点的坐标 ptArr2(0) = x0 - 100: ptArr2(1) = y0 - h0 ptArr2(2) = x0 - b: ptArr2(3) = y0 - h0 ptArr2(4) = x0 - b: ptArr2(5) = y0 - h ptArr2(6) = x0: ptArr2(7) = y0 - h ptArr2(8) = x0: ptArr2(9) = y0 - h0 ptArr2(10) = x0 (n - 1) * t: ptArr2(11) = y0 (n - 1) * s - h0 ptArr2(12) = ptArr1(2 * (2 * n 2) - 4): ptArr2(13) = ptArr1(2 * (2 * n 2) - 3) - h ptArr2(14) = ptArr2(12) b: ptArr2(15) = ptArr2(13) ptArr2(16) = ptArr2(14): ptArr2(17) = ptArr2(15) (h - h0) ptArr2(18) = ptArr1(2 * (2 * n 2) - 2): ptArr2(19) = ptArr1(2 * (2 * n 2) - 1) - h0 '已经计算 bCal = TrueEnd SubPrivate Sub cmdDraw_Click() '判断是否计算 If bCal = False Then MsgBox "请先进行计算，再进行绘图！", vbCritical Exit Sub End If On Error Resume Next ' 连接至 AutoCAD 应用程序 Dim acadApp As AcadApplication Set acadApp = GetObject(, "AutoCAD.Application.16") If Err Then Err.Clear Set acadApp = CreateObject("AutoCAD.Application.16") If Err Then MsgBox Err.Description Exit Sub End If End If ' 连接至 AutoCAD 图形 Dim acadDoc As AcadDocument Set acadDoc = acadApp.ActiveDocument acadDoc.ModelSpace.AddLightWeightPolyline ptArr1 acadDoc.ModelSpace.AddLightWeightPolyline ptArr2 ZoomAll acadApp.Visible = True '绘图完成，要求下一次计算 bCal = FalseEnd SubPrivate Sub cmdExit_Click() EndEnd SubPrivate Sub Form_Load() '默认参数值 txtPtX.Text = 0 txtPtY.Text = 0 txtPtZ.Text = 0 txtStepH.Text = 20 txtStepW.Text = 40 txtStepNum.Text = 10 txtGirderW.Text = 25 txtGirderH.Text = 45 txtBoardT.Text = 15 bCal = FalseEnd Sub
评论